00010	C TYPE 'DO DOD'. USES DREDIT,DRAWIT,DPYIT,FILLER,EDFILL,CB,LOOK.FAI
00100	C SINGLE ITEM IS RESTRICTED TO 200 WDS + 200 WDS FILLER.  9 ITEMS CAN TOTAL 400 WDS.
00200		COMMON /RC/MCLEF(200),IST(4000),MFILL(200)
00300		COMMON /FL/IC,N,NQ,RZ,IXRX,XGP,RXGP
00400		COMMON/ZN/SCLEF(200,2),DDD
00500		COMMON/ED/KED,NEXT,NN,NX,NY,J
00600		DIMENSION JCLEF(10)
00700		EQUIVALENCE (MM,SCLEF(1,1)),(JCLEF,IST)
00800		COMMON /RZ/RSZ,IPLT,RJB,CENTR
00900		DATA RJB/-20./,CENTR/-26./
01000		MCLEF(1)=0
01050		XGRID=0
01100		MFILL(1)=-1
01200		MM=0
01300		IPLTX=-1
01400		K=1
01500		RSZ=0
01700	91	TYPE 100
01800	55	FORMAT(I,2F)
01900	50	FORMAT(2A1)
01950		XGRID=GRID
02000		XSZ=RSZ
02100		ACCEPT 55,J,RSZ,GRID
02150		IF(GRID.EQ.0)GRID=XGRID
02200		IF(RSZ.EQ.0)RSZ=XSZ
02300		REREAD 50,N,JC
02400	C  TO SAVE SIZE FACTOR WHEN REDRAWING.
02500		IF(RSZ.EQ.0)RSZ=9.0
02700		IF(N.EQ.'M')GO TO 192
02800	C  FOR MOVING AND DISTORTING ENTIRE PICTURE
03000		IF(N.EQ.'C')GO TO 999
03100		IF(N.EQ.'X')CALL EXIT
03300	C TYPE 99 TO FINISH PLOT, OTHERWISE NEW UNIT MAY BE READ IN.
03350	C  'G' OR <CR> = GET.
03400		IF(N.NE.'D'.AND.N.NE.'E')GO TO 191
03500		KED=N
03600		MM=MCLEF(1)
03700		IF(MM.NE.0)GO TO 92
03800	C  ADD TO DRAWING?
03900		GO TO 3
04000	999	CALL CMBN
04100		GO TO 111
04200	192	CALL SHIFT
04300		J=1
04400		GO TO 7
04500	191	TYPE 41
04501	CC	IF(J.EQ.10.OR.N.EQ.'S')GO TO 194
04505		IF(JC.EQ.'M'.OR.N.EQ.'S')GO TO 194
04510		MCLEF(1)=0
04526		MFILL(1)=-1
04542		MM=0
04574		IPLTX=-1
04590		K=1
04614	194	IF(JC.EQ.'M')J=1
04616		JC=0
04619		JM=1
04628		JF=1
04637		IF(MCLEF(1).EQ.0)GO TO 193
04646		JC=JCLEF(2)-1
04655		JM=MCLEF(1)+1
04664		JF=MFILL(1)+1
04673		IF(JF.EQ.0)JF=1
04691	193	ACCEPT 10,NM
04700		IF(NM.EQ.' ')GO TO 91
04800		REWIND 1
04900		IF(N.EQ.'S')GO TO 40
04950		IF(LOOKD(NM).EQ.0)GO TO 191
04975	C  'FAIL' ROUTINE TO CHECK ON LOOKUP
05000		CALL IFILE(1,NM)
05100		READ(1,5)M,JCLEF
05110		IF(JC.NE.0)JCLEF(2)=JC+JCLEF(2)
05120		TYPE 1100
05135		ACCEPT 55,J
05142		IF(J.EQ.0)J=1
05150		M=JCLEF(J+1)-JCLEF(J)
05200		TYPE 110,M
05300		IF(J.LE.1)GO TO 60
05500	C  FOR PROTECTION
05600		M=JCLEF(J)
05610		N=JM+1
05700		NX=1
05800	61	READ(1,5)L,L,(MCLEF(K),K=N,JM+L)
05810	C PASSES OVER FIRST ITEM
05900		NX=NX+L
06000		IF(NX.LT.M)GO TO 61
06100	60	NX=JM
06200	6	READ(1,5,END=7)M,L,(MCLEF(M),M=NX,NX+L-1)
06300		IF(MCLEF(NX).EQ.999)GO TO 66
06400		NX=NX+L
06500		GO TO 6
06510	1100	FORMAT(' ITEM NUM?'/)
06600	700	FORMAT(' RESET X-Y POS. ',$)
06700	555	FORMAT(2F)
06800	66	IF(GRID.GT.1)GO TO 7
06850	C??????↑↑↑↑↑  ?? ??
06900		NX=JF
07000	77	READ(1,5)M,L,(MFILL(M),M=NX,NX+L-1)
07010		IF(NX.EQ.JF.AND.JF.GT.1)MFILL(1)=MFILL(1)+JF
07100		NX=NX+L
07200		IF(NX.LE.MFILL(1))GO TO 77
07210	7	IF(JC.EQ.0)GO TO 70
07220		NX=MCLEF(1)+1
07230		NY=MCLEF(NX)-1
07240	C  THE WDCNTS
07250		DO 71 K=NX,MCLEF(1)+NY
07260	71	MCLEF(K)=MCLEF(K+1)
07270	C  WORK IT OUT FOR MFILL!!!!!
07275		MCLEF(1)=MCLEF(1)+NY
07277		IF(JF.LE.1)GO TO 70
07280		NX=2
07285	72	JM=MFILL(NX)+1
07290		IF(JM.EQ.JF)GO TO 73
07295		NX=JM
07300		GO TO 72
07305	73	NX=NX+1
07310	74	NY=MFILL(NX)
07315		MFILL(NX)=MFILL(NX)+JM-2
07320		NX=JM+NY
07325		IF(NX.GT.0.AND.NX.LE.200)GO TO 74
07480	
07485	70	IF(N.NE.'P')GO TO 3
07490		IXRX=1
07500		IF(JC.NE.'X')IXRX=0
07600	C 0=SEND IT TO CALCOMP
07700		TYPE 700
07800		ACCEPT 555,X,Y
07900		IF(X.NE.0)RJB=X/RSZ
08000		IF(Y.NE.0)CENTR=Y/RSZ
08100	C  TYPE .001, .001 TO SET POS. TO 0, -20, -26 IS ORIGINAL.
08200		IF(IPLTX)CALL PLOTS(0)
08300	C  DO I NEED THIS?
08400		IPLTX=0
08500	3	IF(N.NE.'D')MM=0
08600	C  RESET IF NOT GOING TO DRAWIT
08700		IF(GRID.EQ.0)GO TO 333
08800		CALL GRIDS
08900	333	CALL DPYSET(1,IST,4000)
09000		CALL DPYBRT(4)
09100		NIST=IST(2)
09200		IF(N.AND.N.NE.'G'.AND.N.NE.'M')GO TO 92
09300		MM=1
09400		CALL RDRAW(2,MCLEF(1),MCLEF,RJB,CENTR)
09500	C  ABOVE CAN BE "CALL RDRAW"
09600		NIST=IST(2)
09700		IF(MFILL(1))GO TO 91
09800		TYPE 335
09900		ACCEPT 10,J
10000		IF(J.EQ.'N')GO TO 91
10100		CALL FILLER
10200		IF(N.EQ.'P')CALL PLOT(0,0,3)
10300		GO TO 91
10400	335	FORMAT(' FILL IT? ',$)
10500	10	FORMAT(A5)
10600	5	FORMAT(12I)
10800	100	FORMAT(' G=GET, GM=GET MORE, =S=SAVE, D=DRAW, X=EXIT, M=MOVE, 
10850		1P=PLOT, PX=XGP, C=COMBINE'/
10900		1' E=EDIT,   N1=SIZE, N2=1=GRID '/)
11000	C  N1=20 TO CHANGE SHAPE
11100	
11200	92	IST(2)=NIST
11300		CALL DRAWIT
11400	  	N=0
11500		GO TO 3
11600	
11850	403	FORMAT(' WRITE OVER ',A5,'.DAT?  ',$)
12000	41	FORMAT(' TYPE FILE NAME'/)
12100	C  SAVES ONLY ONE PICTURE - USE 999(COMBINE) FOR UP TO 9
12210	40	IF(LOOKD(NM).EQ.0)GO TO 402
12220		TYPE 403,NM
12230		ACCEPT 50,K
12240		IF(K.EQ.'N')GO TO 191
12300	402	IC=MCLEF(1)+1
12400		IF(MFILL(1).GT.0)IC=IC+MFILL(1)+1
12500		CALL OFILE(1,NM)
12600		WRITE(1,120),IC
12700		CALL SAVE(MCLEF)
12800		IF(MFILL(1).LE.0)CALL EXIT
12900		WRITE(1,11)
13000		CALL SAVE(MFILL)
13100	111	TYPE 110,IC
13200	120	FORMAT(' 9999  1 ',I4,' 0 0 0 0 0 0 0 0')
13300	110	FORMAT(' TOTAL WDS=',I3)
13400	11	FORMAT(' 9999  1 999')
13500		END
13600		
13700		SUBROUTINE SAVE(M)
13800		DIMENSION M(1)
13900		J=7
14000		L=8
14100		DO 12 K=1,M(1),8
14200		IF(K+J.LT.M(1))GO TO 12
14300		J=M(1)-K
14400		L=J+1
14500	12	WRITE(1,11)L,(M(NM),NM=K,K+J)
14600		RETURN
14700	11	FORMAT(' 9999',I3,8I10)
14800		END